home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / seditExtras.tcl.z / seditExtras.tcl
Text File  |  2002-07-08  |  30KB  |  1,056 lines
  1. # seditExtras
  2. #
  3. # Extra functions for the edit
  4. #
  5. # Copyright (c) 1994 Xerox Corporation.
  6. # Use and copying of this software and preparation of derivative works based
  7. # upon this software are permitted. Any distribution of this software or
  8. # derivative works must comply with all applicable United States export
  9. # control laws. This software is made available AS IS, and Xerox Corporation
  10. # makes no warranty about the software, its performance or its conformity to
  11. # any specification.
  12. #
  13. #
  14.  
  15. proc SeditWhom { draft f t } {
  16.     global sedit
  17.     set parent [file root $f]
  18.     if {[winfo exists $parent.whom]} {
  19.     destroy $parent.whom
  20.     return
  21.     }
  22.     # Do an unformatted save so Mh_Whom gets the right info
  23.     set format $sedit($t,format)
  24.     set sedit($t,format) Never
  25.     if [catch {
  26.     SeditSave $draft $t
  27.     SeditDirty $t
  28.     } err] {
  29.     set sedit($t,format) $format
  30.     SeditMsg $t $err
  31.     return
  32.     }
  33.     set sedit($t,format) $format
  34.  
  35.     set id [file tail $draft]
  36.     catch {Mh_Whom $id} result
  37.     set lines [llength [split $result \n]]
  38.     set f2 [Widget_Frame $parent whom {top fill}]
  39.     set height [expr {$lines > 8 ? 8 : $lines}]
  40.     set t2 [Widget_Text $f2 $height]
  41.     $t2 configure -height $height    ;# Widget_Text broken
  42.     $t2 insert 1.0 $result
  43.     $t2 config -state disabled
  44.     pack $f2 -before $f -side top
  45. }
  46. proc SeditSign { draft t {f ~/.signature} } {
  47.     global sedit
  48.     if {[catch {glob $f} sig] || [string length $f]==0} {
  49.     return
  50.     }
  51.     set exec 0
  52.     if [file executable $sig] {
  53.     set sig "|$sig $sedit($t,isigc) $sedit($t,isigf) $draft"
  54.     set exec 1
  55.     } else {
  56.     if ![file readable $sig] {
  57.         return
  58.     }
  59.     }
  60.     global sedit
  61.     if [catch {
  62.     set in [open $sig]
  63.     set signature [read $in]
  64.     # check for 8bit characters in the signature
  65.     set 8bit 0
  66.     if [regexp "\[\x80-\xff\]" $signature] {
  67.         set 8bit 1
  68.     }
  69.     if {!$sedit($t,multi)} {
  70.         if ($sedit(sigDashes)) {
  71.         $t insert $sedit(sigPosition) "\n-- \n"
  72.         } else {
  73.         $t insert $sedit(sigPosition) \n\n
  74.         }
  75.         # check for 8bit characters in the signature
  76.         if $8bit {
  77.         set sedit($t,8bit) 1
  78.         }
  79.         $t insert $sedit(sigPosition) $signature
  80.     } else {
  81.         set type text/plain
  82.         if $8bit {
  83.         append type "; charset=iso-8859-1"
  84.         }
  85.         $t mark set fileinsert [SeditAppendPart $type]
  86.         $t insert fileinsert \n
  87.         $t insert fileinsert $signature
  88.     }
  89.     close $in
  90.     } err] {
  91.     if $exec {
  92.         SeditMsg $t "Bogus execute permission on signature file?"
  93.         Exmh_Status "Check execute bit on signature file"
  94.     } else {
  95.         SeditMsg $t $err
  96.         Exmh_Status $err
  97.     }
  98.     }
  99. }
  100. proc SeditSignIntelligent { draft t {f ~/.signature} } {
  101.     global sedit intelligentSign
  102.     global mhProfile
  103.  
  104.     set tmp_fmt $sedit($t,format)
  105.     set sedit($t,format) Never
  106.     set saveokay [SeditSave $draft $t {} 0]
  107.     set sedit($t,format) $tmp_fmt
  108.  
  109.     set cmd {exec whom $draft}
  110.  
  111.     if {!$saveokay || [catch {eval $cmd} rcpts]} {
  112.     Exmh_Status "Error finding recipients; using default signature $f"
  113.     } else {
  114.     regsub -all " at " $rcpts "@" rcpts
  115.     regsub -all "(^|\n)(\[^@\n\]+(\n|\$))+" $rcpts "\\1" rcpts
  116.  
  117.     foreach domn $intelligentSign(domain) {
  118.         regsub -all "(^|\n)(\[^\n\]+$domn\[^\n\]*(\n|\$))+" $rcpts {} rcpts
  119.     }
  120.  
  121.     if {[regexp {[a-zA-Z0-9]} $rcpts]} {
  122.         set f $intelligentSign(external)
  123.         Exmh_Status "Using external signature $f"
  124.     } else {
  125.         set f $intelligentSign(internal)
  126.         Exmh_Status "Using internal signature $f"
  127.     }
  128.     }
  129.     SeditSign $draft $t $f
  130. }
  131. proc SeditInsertFile { draft t file {newpart 0} {encoding {}} {type text/plain} {desc {}}} {
  132.     global sedit mime quote
  133.     if {$newpart < 0} {
  134.     return
  135.     }
  136.     Exmh_Status "SeditInsertFile $file $type $desc"
  137.     if ![file readable $file] {
  138.     SeditMsg $t "Cannot read $file"
  139.     } else {
  140.     if {[regexp ^text $type]} {
  141.         if [catch {open $file r} in] {
  142.         SeditMsg $t $in
  143.         return
  144.         }
  145.         if [regexp "\[\x80-\xff\]" [read $in]] {
  146.         set sedit($t,8bit) 1
  147.         }
  148.         close $in
  149.     }
  150.     set cmd ""
  151.     set uuname [file tail $file]
  152.     if ![regexp name= $type] {
  153.         append type " ; name=\"$uuname\""
  154.     }
  155.     switch -- $encoding {
  156.         base64 {   lappend cmd | $mime(encode) -b }
  157.         quoted-printable {   lappend cmd | $mime(encode) -q }
  158.         none {set encoding {}}
  159.         x-uuencode {   lappend cmd | uuencode $uuname }
  160.     }
  161.     if {[string length $cmd] == 0} {
  162.         set in [open $file]
  163.     } else {
  164.         lappend cmd < $file
  165.         Exmh_Status $cmd
  166.         set in [open $cmd r]
  167.     }
  168.     if [$t compare insert <= hlimit] {
  169.         $t mark set insert "hlimit +1c"
  170.     }
  171.     if {$file == $quote(filename)} {
  172.         set inheaders 1
  173.         set quoted 0
  174.         while {[gets $in line] > -1} {
  175.         if {! $inheaders} {
  176.             $t insert insert $sedit(pref,replPrefix)$line\n
  177.         } else {
  178.             # This simple hack doesn't work for multiparts.
  179.             if [regexp -nocase {^content-transfer-encoding:.*quoted-printable} $line] {
  180.             set quoted 1
  181.             set sedit($t,8bit) 1
  182.             if {$sedit($t,quote) < 0} {
  183.                 set sedit($t,quote) 1
  184.             }
  185.             }
  186.             if {[string length $line] == 0} {
  187.             set inheaders 0
  188.             if {$quoted} {
  189.                 set tfile [Mime_TempFile decode]
  190.                 if [catch {open $tfile w} out] {
  191.                 $t insert insert "Error: $out"
  192.                 } else {
  193.                 puts -nonewline $out [read $in]
  194.                 close $out
  195.                 close $in
  196.                 if [catch {open "|$mime(encode) -q -u < $tfile"} in] {
  197.                     $t insert insert "Error: $in"
  198.                     focus $t
  199.                     return
  200.                 }
  201.                 }
  202.             }
  203.             }
  204.         }
  205.         }
  206.     } else {
  207.         if {$newpart} {
  208.         set ix [SeditMimeType $type]
  209.         if {[string length $ix] == 0} {
  210.             return
  211.         }
  212.         set mark fileinsert
  213.         $t mark set $mark $ix
  214.         if {$desc != {}} {
  215.             $t insert $mark "Content-Description: "
  216.             set sel1 [$t index $mark]
  217.             $t insert $mark "$desc\n"
  218.             set sel2 [$t index "$mark -1 char"]
  219.             $t tag add sel $sel1 $sel2
  220.         }
  221.         if {$encoding != {}} {
  222.             $t insert $mark "Content-Transfer-Encoding: $encoding\n"
  223.         }
  224.         if {$mime(eudora)} {
  225.             if $mime(dosname) {
  226.             set filename [Mime_EudoraFilename $file]
  227.             } else {
  228.             set filename [file tail $file]
  229.             }
  230.             $t insert $mark \
  231.             "Content-Disposition: attachment; filename=\"$filename\"\n"
  232.         }
  233.         $t insert $mark \n
  234.         } else {
  235.         set mark insert
  236.         }
  237.         $t insert $mark [read $in]
  238.     }
  239.     catch {close $in}
  240.     catch {close $filein}
  241.     if [info exists tfile] {
  242.         File_Delete $tfile
  243.     }
  244.     focus $t
  245.     SeditDirty $t
  246.     }
  247. }
  248. proc SeditCiteSelection { draft t } {
  249.     global sedit address
  250.     if [catch {selection get} line] {
  251.     SeditMsg $t "No selection"
  252.     return
  253.     }
  254.  
  255.     # check for 8bit characters in the selection
  256.     if [regexp "\[\x80-\xff\]" $line] {
  257.     set sedit($t,8bit) 1
  258.     }
  259.  
  260.     $t insert insert "\n$address said:\n"
  261.  
  262.     # Divide selection into groups separated by blank lines
  263.     # Control-A is used as a pseudo-newline
  264.     regsub -all "\n\n+" $line \x01 line
  265.  
  266.     set space ""
  267.     set limit 70
  268.     set cutoff 50
  269.  
  270.     regsub -all {]|[.^$*+|()\[\\]} $sedit(pref,replPrefix) {\\&} pattern
  271.     foreach line [split $line \x01] {
  272.     # Preserve line breaks that start with white space or the replPrefix
  273.     regsub -all "\n(\[\ \t\n\]+)" $line \x01\\1 line
  274.     regsub -all "\n$pattern" $line \x01 line
  275.     # Eliminate leading replPrefix
  276.     regsub  "^$pattern" $line "" line
  277.     # Eliminate other line breaks
  278.     regsub -all \n $line " " line
  279.  
  280.     foreach line [split $line \x01] {
  281.         while {[string length $line] > $limit} {
  282.         set hit 0
  283.         for {set c $limit} {$c >= $cutoff} {incr c -1} {
  284.             set char [string index $line $c]
  285.             if [regexp \[\ \t\n>/\] $char] {
  286.             set hit 1
  287.             break
  288.             }
  289.         }
  290.         if !$hit {
  291.             set c $limit
  292.         }
  293.         set newline [string trimright [string range $line 0 $c]]
  294.         $t insert insert "$sedit(pref,replPrefix)$newline\n"
  295.         set space \n
  296.         incr c
  297.         set line [string range $line $c end]
  298.         }
  299.         $t insert insert "$sedit(pref,replPrefix)$line\n"
  300.     }
  301.     $t insert insert $space
  302.     }
  303.  
  304. }
  305.  
  306. proc Sedit_FormatParagraph { t } {
  307.     global sedit address
  308.     if [catch {$t index "sel.first linestart"} first] {
  309.     set first [$t index "insert linestart"]
  310.     set last [$t index "insert lineend"]
  311.     while 1 {
  312.         set line [$t get $first "$first lineend"]
  313.         set len [string length $line]
  314.         if {$len == 0} {
  315.         break
  316.         }
  317.         set first [$t index "$first - 1line"]
  318.         if {[regexp ^-- $line] || [$t compare $first <= hlimit]} {
  319.         break
  320.         }
  321.     }
  322.     set first [$t index "$first + 1line"]
  323.     while 1 {
  324.         set line [$t get "$last linestart" $last]
  325.         set len [string length $line]
  326.         if {($len == 0) || [regexp ^-- $line]} {
  327.         set last [$t index "$last - 1line lineend +1char"]
  328.         break
  329.         }
  330.         set nlast [$t index "$last + 1line lineend"]
  331.         if {[$t compare $nlast == $last]} {
  332.         break
  333.         }
  334.         set last $nlast
  335.     }
  336.     } else {
  337.     set last [$t index "sel.last lineend"]
  338.     }
  339.     set line [$t get $first "$last -1char"]
  340.     set tags [$t tag names $first]
  341.     $t delete $first $last
  342.     $t mark set insert $first
  343.  
  344.     # Divide selection into groups separated by blank lines
  345.     # Control-A is used as a pseudo-newline
  346.     regsub -all "\n\n+" $line \x01 line
  347.  
  348.     set space ""
  349.     set limit $sedit(lineLength)
  350.     set cutoff 0
  351.  
  352.     # Escape Tcl specials
  353.     regsub -all {]|[.^$*+|()\[\\]} $sedit(pref,replPrefix) {\\&} pattern
  354.     foreach line [split $line \x01] {
  355.     # Preserve line breaks that start with white space or the replPrefix
  356.     regsub -all "\n(\[\ \t\n\]+)" $line \x01\\1 line
  357.     regsub -all "\n$pattern" $line \x01 line
  358.     # Eliminate other line breaks
  359.     regsub -all " *\n" $line " " line
  360.  
  361.     $t insert insert $space
  362.     set space \n
  363.  
  364.     foreach line [split $line \x01] {
  365.         while {[string length $line] > $limit} {
  366.         set hit 0
  367.         for {set c $limit} {$c >= $cutoff} {incr c -1} {
  368.             set char [string index $line $c]
  369.             if [regexp \[\ \t\n>/\] $char] {
  370.             set hit 1
  371.             break
  372.             }
  373.         }
  374.         if !$hit {
  375.             set c $limit
  376.         }
  377.         set newline [string trimright [string range $line 0 $c]]
  378.         $t insert insert "$newline\n" $tags
  379.         incr c
  380.         set line [string range $line $c end]
  381.         }
  382.         $t insert insert "$line\n" $tags
  383.     }
  384.     }
  385.     $t mark set insert "insert -1char"
  386.  
  387. }
  388.  
  389. proc SeditInsertFileDirect { draft t } {
  390.     global sedit
  391.     set name [FSBox "Select file name"]
  392.     if {$name != ""} {
  393.     if [file readable $name] {
  394.         # check for 8bit characters in the file
  395.         catch {
  396.         set in [open $name]
  397.         if [regexp "\[\x80-\xff\]" [read $in]] {
  398.             set sedit($t,8bit) 1
  399.         }
  400.         close $in
  401.         }
  402.         SeditInsertFile $draft $t $name
  403.     } else {
  404.         SeditMsg $t "Cannot read $name"
  405.     }
  406.     }
  407. }
  408. proc SeditInsertFileDialog { draft t } {
  409.     global sedit
  410.     set name [FSBox "Select file name"]
  411.     if {$name != ""} {
  412.     if [file readable $name] {
  413.         set options [SeditFormatDialog $t $name]
  414.         eval {SeditInsertFile $draft $t $name} $options
  415.         Sedit_FixPgpFormat [SeditId $draft]
  416.     } else {
  417.         SeditMsg $t "Cannot read $name"
  418.     }
  419.     }
  420. }
  421. # Thanks to Anders Klemets, klemets@it.kth.se, for the message/external feature.
  422. # Valdis Kletnieks, 12/15/1999 - re-write for sane support of RFC2017 URL
  423. # references - ask for type *first*, and handle the cases differently.
  424.  
  425. proc SeditInsertExternalDialog { draft t } {
  426.     global sedit env
  427.  
  428.     catch {destroy $t.format}
  429.     set f [frame $t.format -bd 2 -relief ridge]
  430.     message $f.msg -text "Access type?" -aspect 1000
  431.     pack $f.msg -side top -fill both
  432.     set b1 [frame $f.but1 -bd 10 -relief flat]
  433.     set b3 [frame $f.but3 -bd 10 -relief flat]
  434.     pack $b1 $b3 -side top
  435.  
  436.     button $b3.plain -text "Cancel" -command [list SeditFormatNewPart $t $f -1]
  437.     button $b3.newpart -text "OK" -command [list SeditFormatNewPart $t $f 1]
  438.     pack $b3.plain $b3.newpart -side left -padx 3
  439.  
  440.     radiobutton $b1.local -text "Local file" -variable sedit($t,extaccesstype) -value LOCAL-FILE
  441.     radiobutton $b1.anon -text "Anonymous FTP" -variable sedit($t,extaccesstype) -value ANON-FTP
  442.     radiobutton $b1.url -text "URL" -variable sedit($t,extaccesstype) -value URL
  443.     pack $b1.local $b1.anon $b1.url -side left -padx 3
  444.  
  445.     $b1.local select
  446.  
  447.     set sedit($t,encoding) {}
  448.     set sedit($t,compress) {}
  449.     set sedit($t,newpart) 0
  450.     set sedit($t,extaccesstype) local
  451.  
  452.     Widget_PlaceDialog $t $f
  453.     tkwait window $f
  454.  
  455.     if {$sedit($t,extaccesstype) == "URL"} {
  456.     set name {}
  457.     set options [SeditExternalUrlDialog $t $name]
  458.     } else {
  459.         set name [FSBox "(Optionally) Select file name"]
  460.         set options [SeditExternalFileDialog $t $name]
  461.         }
  462.     set tmpfname [Mime_TempFile extern]
  463.     if [catch {open $tmpfname w} fp] {
  464.         SeditMsg $t $fp
  465.         return
  466.     }
  467.     puts $fp "Content-Type: $sedit($t,exttype)"
  468.     # Construct content-id
  469.     regsub -all " |:" [exec date] _ date
  470.     puts $fp [format "Content-ID: <%s_%s@%s>\n" $env(USER) $date \
  471.                     [exec hostname]]
  472.     close $fp
  473.     eval {SeditInsertFile $draft $t $tmpfname} $options
  474.     Sedit_FixPgpFormat [SeditId $draft]
  475.     File_Delete $tmpfname
  476. }
  477. proc SeditExternalFileDialog { t name } {
  478.     global sedit
  479.     catch {destroy $t.format}
  480.     set f [frame $t.format -bd 2 -relief ridge]
  481.  
  482.     message $f.msg1 -text "Insert external reference to file" -aspect 1000
  483.     pack $f.msg1 -side top -fill both
  484.  
  485.     Widget_BeginEntries 15 30 [list SeditFormatNewPart $t $f 1]
  486.     set sedit($t,desc) [file tail $name]
  487.     Widget_LabeledEntry $f.e0 Description: sedit($t,desc)
  488.  
  489.     catch {exec hostname} sedit($t,extsite)
  490.     Widget_LabeledEntry $f.e1 Site: sedit($t,extsite)
  491.  
  492.     set sedit($t,extdirectory) [file dirname $name]
  493.     Widget_LabeledEntry $f.e2 Directory: sedit($t,extdirectory)
  494.  
  495.     set sedit($t,extname) [file tail $name]
  496.     Widget_LabeledEntry $f.e3 "File name" sedit($t,extname)
  497.     Widget_BindEntryCmd $f.e3.entry <Return> \
  498.     [list SeditTweakContentType sedit($t,extname) sedit($t,exttype) $sedit($t,extname)]
  499.  
  500.     SeditTweakContentType sedit($t,extname) sedit($t,exttype) $name
  501.     Widget_LabeledEntry $f.e4 "Content-Type:" sedit($t,exttype)
  502.  
  503.     set sedit($t,trans-mode) image
  504.     Widget_LabeledEntry $f.e5 "Transfer mode:" sedit($t,trans-mode)
  505.  
  506.     Widget_EndEntries
  507.     set b3 [frame $f.but3 -bd 10 -relief flat]
  508.  
  509.     button $b3.plain -text "Cancel" -command [list SeditFormatNewPart $t $f -1]
  510.     button $b3.newpart -text "OK" -command [list SeditFormatNewPart $t $f 1]
  511.     pack $b3.plain $b3.newpart -side left -padx 3
  512.  
  513.     pack $b3 -side top
  514.     Widget_PlaceDialog $t $f
  515.     tkwait window $f
  516.  
  517.     if {$sedit($t,extaccesstype) == "LOCAL-FILE"} {
  518.     set sedit($t,type) "message/external-body;\n\tname=\"$sedit($t,extdirectory)/$sedit($t,extname)\";\n\taccess-type=$sedit($t,extaccesstype)"
  519.     if {[string length $sedit($t,extsite)] != 0} {
  520.         append sedit($t,type) ";\n\tsite=\"$sedit($t,extsite)\""
  521.     }
  522.     } else {
  523.     set sedit($t,type) "message/external-body;\n\tname=\"$sedit($t,extname)\";\n\tsite=\"$sedit($t,extsite)\";\n\taccess-type=$sedit($t,extaccesstype);\n\tdirectory=\"$sedit($t,extdirectory)\";\n\tmode=\"$sedit($t,trans-mode)\""
  524.     }
  525.  
  526.     return [list $sedit($t,newpart) $sedit($t,encoding) $sedit($t,type) $sedit($t,desc)]
  527. }
  528. proc SeditExternalUrlDialog { t name } {
  529.     global sedit
  530.     catch {destroy $t.format}
  531.     set f [frame $t.format -bd 2 -relief ridge]
  532.  
  533.     message $f.msg1 -text "Insert external reference to URL" -aspect 1000
  534.     pack $f.msg1 -side top -fill both
  535.  
  536.     Widget_BeginEntries 15 30 [list SeditFormatNewPart $t $f 1]
  537.     set sedit($t,desc) {}
  538.     Widget_LabeledEntry $f.e0 Description: sedit($t,desc)
  539.     set sedit($t,url) {}
  540.     Widget_LabeledEntry $f.e1 URL: sedit($t,url)
  541.     Widget_BindEntryCmd $f.e1.entry <Return> \
  542.     [list SeditTweakContentType sedit($t,url) sedit($t,exttype) $sedit($t,url)]
  543.     set sedit($t,exttype) "text/html"
  544.     Widget_LabeledEntry $f.e2 "Content-Type:" sedit($t,exttype)
  545.  
  546.     Widget_EndEntries
  547.  
  548.     set b3 [frame $f.but3 -bd 10 -relief flat]
  549.     button $b3.plain -text "Cancel" -command [list SeditFormatNewPart $t $f -1]
  550.     button $b3.newpart -text "OK" -command [list SeditFormatNewPart $t $f 1]
  551.     pack $b3.plain $b3.newpart -side left -padx 3
  552.  
  553.     pack $b3 -side top
  554.     Widget_PlaceDialog $t $f
  555.     tkwait window $f
  556.  
  557.     set sedit($t,name) [file tail $sedit($t,url)];
  558.     set sedit($t,type) "message/external-body;\n\tURL=\"$sedit($t,url)\";\n\taccess-type=URL"
  559.  
  560.     return [list $sedit($t,newpart) $sedit($t,encoding) $sedit($t,type) $sedit($t,desc)]
  561. }
  562. proc SeditTweakContentType { nameVar contentVar filenameOrig } {
  563.     global sedit
  564.     upvar #0 $nameVar name
  565.     upvar #0 $contentVar content
  566.     if {[ string length $filenameOrig ] == 0 } { set filenameOrig $name }
  567.     if [catch {SeditGuessContentType $filenameOrig} content] {
  568.     Exmh_Status $content
  569.     set content $sedit(defaultType)
  570.     }
  571. }
  572. proc SeditFormatDialog { t name } {
  573.     global sedit
  574.     set f [frame $t.format -bd 2 -relief ridge]
  575.  
  576.     if [catch {SeditGuessContentType $name} sedit($t,type)] {
  577.     Exmh_Status $sedit($t,type)
  578.     set sedit($t,type) "$sedit(defaultType); name=\"[file tail $name]\""
  579.     }
  580.     message $f.msg1 -text "File Insert [file tail $name]" -aspect 1000
  581.     pack $f.msg1 -side top -fill both
  582.  
  583.     Widget_BeginEntries 13 30 [list SeditFormatNewPart $t $f 1]
  584.     Widget_LabeledEntry $f.e1 "Content-Type:" sedit($t,type)
  585.  
  586.     set sedit($t,desc) [file tail $name]
  587.     Widget_LabeledEntry $f.e2 "Description:" sedit($t,desc)
  588.     Widget_EndEntries
  589.  
  590.     message $f.msg -text "Transfer encoding?" -aspect 1000
  591.     pack $f.msg -side top -fill both
  592.     set b1 [frame $f.but1 -bd 10 -relief flat]
  593.     set b3 [frame $f.but3 -bd 10 -relief flat]
  594.     pack $b1 $b3 -side top
  595.  
  596.     set sedit($t,encoding) {}
  597.     set sedit($t,compress) {}
  598.     set sedit($t,newpart) 0
  599.  
  600.     button $b3.plain -text "Cancel" -command [list SeditFormatNewPart $t $f -1]
  601.     button $b3.newpart -text "OK" -command [list SeditFormatNewPart $t $f 1]
  602.     pack $b3.plain $b3.newpart -side left -padx 3
  603.  
  604.     radiobutton $b1.none -text "None" -variable sedit($t,encoding) -value {}
  605.     radiobutton $b1.base64 -text "Base64" -variable sedit($t,encoding) -value base64
  606.     radiobutton $b1.quoted -text "QuotedPrintable" -variable sedit($t,encoding) -value quoted-printable
  607.     radiobutton $b1.uu -text "X-uuencode" -variable sedit($t,encoding) -value x-uuencode
  608.     pack $b1.none $b1.base64 $b1.quoted $b1.uu -side left -padx 3
  609.  
  610. #   Guess an appropriate content transfer encoding for this part,
  611. #   based on recommendations in Appendix F of the MIME RFC.
  612.     switch -glob -- $sedit($t,type) {
  613.     text/plain        { $b1.none select }
  614.     text/*            { $b1.quoted select }
  615.     multipart/*        { $b1.none select }
  616.     message/*        { $b1.none select }
  617.     application/postscript    { $b1.quoted select }
  618.     application/*        { $b1.base64 select }
  619.     image/*            { $b1.base64 select }
  620.     audio/*            { $b1.base64 select }
  621.     video/*            { $b1.base64 select }
  622.     *            { $b1.base64 select }
  623.     }
  624.     Widget_PlaceDialog $t $f
  625.     tkwait window $f
  626.     return [list $sedit($t,newpart) $sedit($t,encoding) $sedit($t,type) $sedit($t,desc)]
  627. }
  628. proc SeditFormatNewPart { t f {doit 0} } {
  629.     global sedit
  630.     set sedit($t,newpart) $doit
  631.     destroy $f
  632. }
  633. proc SeditSpell { draft f t } {
  634.     global sedit editor wish
  635.     set parent [file root $f]
  636.     if {[winfo exists $parent.spell]} {
  637.     destroy $parent.spell
  638.     return
  639.     }
  640.     # Do an unformatted save so spell gets the right info
  641.     set path [Env_Tmp]/exmh.s[pid].[file tail $t]
  642.     SeditSaveBody $t $path
  643.  
  644.     switch -- $sedit(spell) {
  645.     ispell {set prog {exmh-async xterm -e ispell}}
  646.     custom {set prog $editor(spell)}
  647.     default {set prog spell}
  648.     }
  649.     if [string match exmh-async* $prog] {
  650.     # exmh-async isn't really right
  651.     # craft a wish script instead
  652.     set script [Env_Tmp]/exmh.w[pid].[file tail $t]
  653.     if [catch {open $script w} out] {
  654.         Exmh_Status $out
  655.         return 0
  656.     }
  657.     puts $out "wm withdraw ."
  658.     puts $out "catch \{"
  659.     puts $out "exec [lrange $editor(spell) 1 end] $path"
  660.     puts $out "\}"
  661.     puts $out [list send [winfo name .] [list SeditReplaceBody $t $path]]
  662.     puts $out "exec rm -f $path"
  663.     puts $out "exec rm -f $script"
  664.     puts $out exit
  665.     close $out
  666.     exec $wish -f $script &
  667.     return
  668.     }
  669.     # Display the results of the spell program
  670.     catch {eval exec $prog {$path}} result
  671.     catch {exec rm $path}
  672.  
  673.     set f2 [Widget_Frame $parent spell {top fill}]
  674.  
  675.     set lines [llength [split $result \n]]
  676.     set height [expr {$lines > 8 ? 8 : $lines}]
  677.     set t2 [Widget_Text $f2 $height]
  678.     $t2 configure -height $height    ;# Widget_Text broken
  679.     $t2 insert 1.0 $result
  680.     $t2 config -state disabled
  681.     pack $f2 -before $f -side top
  682. }
  683. proc Sedit_Find {draft t} {
  684.     global sedit
  685.     if [catch {selection get} string] {
  686.     SeditMsg $t "Select a string first"
  687.     return
  688.     }
  689.     # hack
  690.     global find
  691.     if ![info exists find(line)] {
  692.     set find(line) {}
  693.     }
  694.     if ![info exists find(lasthit)] {
  695.     set find(lasthit) {}
  696.     }
  697.     set sedit(searchWidget) $t
  698.     set match [Find_Inner $string forw $find(line) [lindex [split [$t index end] .] 0] Sedit_FindMatch nofeedback]
  699.     case $match {
  700.     0 {
  701.         SeditMsg $t "Next search will wrap."
  702.     }
  703.     -1 {
  704.         SeditMsg $t "$string not found"
  705.     }
  706.     default {
  707.         SeditMsg $t $draft
  708.         $t mark set insert sel.first
  709.         focus $t
  710.     }
  711.     }
  712. }
  713. proc Sedit_FindMatch { L string } {
  714.     global sedit
  715.     return [FindTextMatch $sedit(searchWidget) $L $string]
  716. }
  717. proc SeditGuessContentType { filenameOrig } {
  718.     global exmh mimeType sedit
  719.  
  720.     set filename [string tolower $filenameOrig]
  721.     set type {}
  722.     if ![info exists mimeType] {
  723.     SeditLoadMimeTypes
  724.     }
  725.     if [regexp -- {^([1-9][0-9]*|@)$} [file tail $filename]] {
  726.     return message/rfc822
  727.     }
  728.     set suffix [file extension $filename]
  729.     set newfilename [file rootname $filename]
  730.     while {$newfilename != $filename} {
  731.     if [info exists mimeType($suffix)] {
  732.         set type $mimeType($suffix)
  733.     }
  734.     set filename $newfilename
  735.     set suffix "[file extension $filename]$suffix"
  736.     set newfilename [file rootname $filename]
  737.     }
  738.     if {[string length $type] == 0} {
  739.     if [catch {set type [mailcap_guess_content_type $filename]}] {
  740.         if {[string length [set type [Mime_Magic $filenameOrig]]] == 0} {
  741.         return $sedit(defaultType)
  742.         }
  743.     }
  744.     }
  745.     return $type
  746. }
  747. proc SeditLoadMimeTypes {} {
  748.     global exmh mimeType env mimetypes_default
  749.     # A few defaults
  750.     set mimeType(.au)  audio/basic
  751.     set mimeType(.gif) image/gif
  752.     set mimeType(.ps)  application/postscript
  753.     set mimeType(.txt) text/plain
  754.     SeditReadMimeTypes $exmh(library)/mime.types        ;# depreciated
  755.     SeditReadMimeTypes $exmh(library)/local.mime.types        ;# depreciated
  756.     SeditReadMimeTypes $mimetypes_default            ;# new
  757.     SeditReadMimeTypes $env(HOME)/.mime.types
  758.     SeditReadMimeTypes $exmh(userLibrary)/user.mime.types
  759. }
  760. proc SeditReadMimeTypes {file} {
  761.     global mimeType
  762.     if [catch {open $file} in] {
  763.     return
  764.     }
  765.     while {[gets $in line] >= 0} {
  766.     if [regexp {^(     )*$} $line] {
  767.         continue
  768.     }
  769.     if [regexp {^(     )*#} $line] {
  770.         continue
  771.     }
  772.     if [regexp {([^     ]+)[     ]+(.+)$} $line match type rest] {
  773.         foreach item [split $rest] {
  774.         if [string length $item] {
  775.             set mimeType(.$item) $type
  776.         }
  777.         }
  778.     }
  779.     }
  780. }
  781.  
  782. proc SeditCheckForIsigHeader { t hdrline } {
  783.     # Check whether there's an existing X-Exmh-Isig-Folder or
  784.     # X-Exmh-Isig-CompType header line
  785.     if {[catch {set end [$t index hlimit]}] &&
  786.     [catch {set end [$t index header]}]} {
  787.         set end end
  788.     }
  789.     set X [$t get 1.0 $end]
  790.     if {![regexp -nocase "(^|\n)x-exmh-isig-$hdrline:\[ \t\]*(\[^\n\]*)\n" $X bin1 bin2 cont]} {
  791.     return {}
  792.     }
  793.     return $cont
  794. }
  795. proc SeditSetIsigHeader { t hook svar evar } {
  796.     global exmh sedit intelligentSign
  797.     set cont [eval SeditCheckForIsigHeader $t $hook]
  798.     if {$cont == {}} {
  799.     set sedit($t,$svar) $exmh($evar)
  800.     if {$intelligentSign(showhdrs)} {
  801.         $t insert 1.0 "X-Exmh-Isig-$hook: $sedit($t,$svar)\n"
  802.     }
  803.     } else {
  804.     set sedit($t,$svar) $cont
  805.     if {!$intelligentSign(showhdrs)} {
  806.         if {[catch {set end [$t index hlimit]}] &&
  807.         [catch {set end [$t index header]}]} {
  808.             set end end
  809.         }
  810.         for {set spos [$t search -regexp -nocase "^x-exmh-isig-$hook:.*\$" 1.0 $end]} {$spos != {}} {} {
  811.         set sidx [$t index $spos]
  812.         regexp {([0-9]*)\..*} $sidx bin1 line
  813.         incr line
  814.         $t delete $spos $line.0
  815.         set spos [$t search -regexp -nocase "^x-exmh-isig-$hook:.*\$" 1.0 $end]
  816.         }
  817.     }
  818.     }
  819. }
  820. proc SeditCheckForIsigHeaders { t } {
  821.     global sedit
  822.     set cont [SeditCheckForIsigHeader $t CompType]
  823.     if {$cont != {}} {
  824.     set sedit($t,isigc) $cont
  825.     }
  826.     set cont [SeditCheckForIsigHeader $t Folder]
  827.     if {$cont != {}} {
  828.     set sedit($t,isigf) $cont
  829.     }
  830. }
  831. proc SeditSetIsigHeaders { t ctype} {
  832.     global exmh
  833.     SeditSetIsigHeader $t CompType isigc $ctype
  834.     SeditSetIsigHeader $t Folder isigf folder
  835. }
  836.  
  837. # proc SeditClip: Use Clip from Sedit as a previewer
  838.  
  839. proc SeditClip {draft t} {
  840.     global mhProfile
  841.  
  842.     if [SeditIsDirty $t] {
  843.         if ![SeditSave $draft $t] {
  844.         return 0
  845.         }
  846.     SeditDirty $t    ;# force abort check
  847.     }
  848.     set id [SeditId $draft]
  849.     if [regexp {^[0-9]+$} $id] {
  850.     set f $mhProfile(draft-folder)
  851.     } else {
  852.     set f [file dirname $id]
  853.     set id [file tail $id]
  854.     }
  855.     Msg_Clip $f $id
  856. }
  857.  
  858. # Stub for users of Sedit_Mailto
  859. proc Sedit_Mailto { url } {
  860.     Msg_Mailto $url
  861. }
  862.  
  863. # Run MHN now to format a message
  864. proc SeditMHN {draft t} {
  865.     global env sedit editor
  866.  
  867.     set format $sedit($t,format)
  868.     set sedit($t,format) Never
  869. # add these two clauses from SeditSend
  870.     if {$sedit($t,mhn)} {
  871.       SeditFixupMhn $draft $t
  872.     }
  873.     if {$sedit(iso)} {
  874.       SeditFixupCharset $draft $t
  875.     }
  876.     if [catch {SeditSave $draft $t {} 0} err] {
  877.     SeditMsg $t $err
  878.     set sedit($t,format) $format
  879.     return
  880.     }
  881.     set sedit($t,format) $format
  882.  
  883.     set env(mhdraft) $draft
  884.     if [catch {exec $editor(mhn) $draft} err] {
  885.     SeditMsg $t $err
  886.     } else {
  887.     if [catch {open $draft r} in] {
  888.         SeditMsg $t "Cannot open $draft"
  889.     } else {
  890.         $t delete 1.0 end
  891.         SeditMimeReset $t
  892.         $t insert 1.0 [read $in]
  893.         close $in
  894.         SeditPositionCursor $t
  895.         SeditMimeParse $t
  896.     }
  897.     }
  898. }
  899.  
  900. # The next three procedures add widgets that let you filter selected
  901. # text through an arbitrary Unix filter.  
  902.  
  903. proc SeditShellDo {t e m b} {
  904.     global SeditShellUndoText
  905.  
  906.     if {![info exists SeditShellUndoText]} {
  907.     set SeditShellUndoText ""
  908.     }
  909.  
  910.     set c [string trim [$e get]]
  911.     set last_idx [$m index last]
  912.     set insert 1
  913.  
  914.     if {[string compare $last_idx none]} {
  915.     for {set idx 0} {$idx <= $last_idx} {incr idx} {
  916.         set label [lindex [$m entryconfigure $idx -label] end]
  917.         if {![string compare $label $c]} {
  918.         set insert 0
  919.         break
  920.         }
  921.     }
  922.     }
  923.  
  924.     if {$insert == 1} {
  925.         set fh [open [glob ~]/.exmh/exmh-shell-history a]
  926.         puts $fh \
  927.             "\$m add command -label {$c} -command \[list SeditShellMenu \$e {$c} \$b\]"
  928.         close $fh
  929.         $m add command -label $c -command [list SeditShellMenu $e $c $b]
  930.     }
  931.  
  932.     if {![catch {set tndx [$t index sel.first]}] &&
  933.         ![catch {set selection [selection get]}]} {
  934.  
  935.     set SeditShellUndoText $selection
  936.  
  937.         if {![catch {set res [exec -keepnewline sh -c "$c" << $selection]}]} {
  938.         $t delete sel.first sel.last
  939.         $t mark set insert $tndx
  940.         $t insert insert $res sel
  941.     }
  942.     }
  943. }
  944.  
  945. proc SeditShellUndo {t} {
  946.     global SeditShellUndoText
  947.  
  948.     if {![info exists SeditShellUndoText]} {
  949.     set SeditShellUndoText ""
  950.     }
  951.  
  952.     if {![catch {set tndx [$t index sel.first]}]} {
  953.         $t delete sel.first sel.last
  954.         $t mark set insert $tndx
  955.         $t insert insert $SeditShellUndoText sel
  956.     }
  957. }
  958.  
  959. proc SeditShellMenu {e c b} {
  960.     $e delete 0 end
  961.     $e insert end $c
  962.     $b invoke
  963. }
  964.  
  965. proc SeditShellCreate {t} {
  966.  
  967.     set w [winfo parent [winfo parent $t]]
  968.  
  969.     if {![winfo exists $w.jkf]} {
  970.  
  971.         set w $w.jkf
  972.  
  973.         pack [frame $w] -side top -fill x -ipady 2 -expand no
  974.         pack [frame $w.f1] -side top -fill x -expand no
  975.  
  976.         set f1 $w.f1
  977.         set e $f1.e
  978.         set m $f1.m.m
  979.         set b $f1.b1
  980.         set b2 $f1.b2
  981.  
  982.         pack [label $f1.l -text Filter] -side left
  983.         pack [entry $e] -side left -expand yes -fill x -ipady 2
  984.         pack [button $b -text Filter \
  985.                 -command [list SeditShellDo $t $e $m $b]] -side left -ipady 2
  986.         pack [button $b2 -text Undo \
  987.                 -command [list SeditShellUndo $t]] -side left -ipady 2
  988.         pack [menubutton $f1.m -text History -menu $m] -side left -ipady 2
  989.         menu $m -tearoff false
  990.  
  991.         if {![catch { source [glob ~]/.exmh/exmh-shell-history } res]} {
  992.         Exmh_Debug "Couldn't source shell history: $res"
  993.     }
  994.  
  995.     # Without this, the new widgets aren't always visible.
  996.     event generate $t <Configure>
  997.     }
  998. }
  999.  
  1000. proc SeditExternalCmd { draft t cmd } {
  1001.     # Save message, process with external command, and reload
  1002.     # last argument to command will be draft file name.
  1003.     SeditSave $draft $t
  1004.     if [catch {eval exec $cmd $draft} err] {
  1005.     Exmh_Debug "$err while executing external command."
  1006.     } else {
  1007.     if [catch {open $draft r} in] {
  1008.         SeditMsg $t "Cannot open $draft"
  1009.     } else {
  1010.         $t delete 1.0 end
  1011.         SeditMimeReset $t
  1012.         $t insert 1.0 [read $in]
  1013.         close $in
  1014.         SeditPositionCursor $t
  1015.         SeditMimeParse $t
  1016.     }
  1017.     }
  1018. }
  1019.  
  1020. proc SeditAttachQuotedMessage { draft t name } {
  1021.     global sedit
  1022.     if {$name != ""} {
  1023.     if [file readable $name] {
  1024.         set options [SeditFormatDialog $t $name]
  1025.         eval {SeditInsertFile $draft $t $name} $options
  1026.     } else {
  1027.         SeditMsg $t "Cannot read $name"
  1028.     }
  1029.     }
  1030. }
  1031.  
  1032. proc SeditInsertMessageDialog { draft t } {
  1033.     global sedit msg
  1034.     set name [FSBox "Select message" $msg(path)]
  1035.     if {$name != ""} {
  1036.     if [file readable $name] {
  1037.         set options [SeditFormatDialog $t $name]
  1038.         eval {SeditInsertFile $draft $t $name} $options
  1039.         Sedit_FixPgpFormat [SeditId $draft]
  1040.     } else {
  1041.         SeditMsg $t "Cannot read $name"
  1042.     }
  1043.     }
  1044. }
  1045.  
  1046. # I had this in pgp.tcl, but I don't want that entire file loaded
  1047. # if this is called.
  1048. proc Sedit_FixPgpFormat {id} {
  1049.     global pgp
  1050.     if {$pgp(enabled) && ($pgp(format,$id) == "plain")} {
  1051.     Exmh_Status "Changed PGP encoding from plain to multipart"
  1052.     set pgp(format,$id) "pm"
  1053.     }
  1054. }
  1055.  
  1056.